Enigma Machine – Type Provider Edition

:: fsharp, type providers

Following up from @isaac_abraham’s awesome F# Enigma machine emulator, I decided it would be 10x cooler if it was in a type provider, because let’s face it, everything is 10x cooler once it’s in a type provider.

Here a some pictures of it in action!

enigma1 enigma2

As you can see, it uses an extensive property system that presents a menu along with the various controls to setup your enigma machine, and then finally to translate some text. This TP is written with my InteractiveProvideras per usual. On my first attempt at this during my lunch break today, I did succeed but I was growing increasingly frustrated with the somewhat contrived mechanism with which to process responses from properties, the text to display in intellisense, and the properties to show.

The Old System

The InteractiveProvider (henceforth known as IP) presents a very flexible yet slightly complicated interface with which to generate types. Essentially, you implement IInteractiveState on some state object of your design, and IInteractiveServer on another type, which deals with processing responses. The IP will display intellisense and options via the state, and when the user selects a property, the server decides what to do with it and returns some new state.

This is very cool as your state object can be whatever you like – record types, DU’s, or full classes. Responses to property access can similar be of any type you like, and can be different on each property if you like. The problems with this system are

  1. The creation of the text and properties is separate from the response handling of that property. This can make it hard to read and reason about.
  2. It is a bit unsafe because everything gets boxed, unboxed, and each time the server has to deal with a response, based on the current state you have to make sure you are dealing with the correct types coming back from the TP which can be a hit messy and detract from what you are really trying to do
  3. Although each state might require its own unique data, there is not any way to represent one thing without threading all the previous state through. For example, if I want the user to enter a bunch of letters via properties until they press the [End] property, I can’t do this with just a string, Id have to carry the rest of whatever data I was using as well. This gets unwieldy quickly. There is no way to separate concerns.
  4. Again on with point 3, because of this it is not really possible to create re-usable chunks of state that perform common functions such as accepting input.

The new system

In order to address this, I introduced another layer of abstraction, ‘cos you can never have too many layers of abstraction right? :)

1
2
3
4
5
6
7
8
9
 
type InteractiveState<'a> = 
  { displayOptions : 'a -> (string * obj) list 
    displayText : 'a -> string 
    processResponse : 'a * obj -> IInteractiveState 
    state : 'a } 
    member x.ProcessResponse o = x.processResponse (x.state, o) 
    interface IInteractiveState with 
     member x.DisplayOptions = x.displayOptions x.state 
     member x.DisplayText = x.displayText x.state

This new record type is essentially a super-duper state object. It brings together the creation of stuff and the processing of responses into the same place. You can see it takes 3 functions and a bit of state, ‘a.

  • displayOptionswill be called with the current ‘a and is expected to generate a list of properties to display and a boxed version of some type that will be passed back to the server when the user selects that property.
  • displayText will be called with the current ‘a and used to generate what appears in intellisense when this type is currently selected (more on this later)
  • processResponsewill be called with the current ‘a and is expected to return a new IInteractiveState

Because this is a generic type, it does mean when you start to use these together, they are going to need the same ‘a which is a bit of a pain, but it is readily solved by creating a DU of all the possible types that the various states in your system need.

1
2
3
4
5
6
7
8
 
type EnigmaTypes = 
 | Core of EnigmaCore.Enigma 
 | Strings of string 
 | Rotors of MachineRotor 
 with 
   member x.Enigma = match x with Core e -> e | _ -> failwith "" 
   member x.String = match x with Strings s -> s | _ -> failwith "" 
   member x.Rotor = match x with Rotors r -> r | _ -> failwith ""

This is not very nice but a very reasonable trade off for the power attained. Now the server object itself becomes very simple (infact this can be generalized as well)

1
2
3
4
5
6
 
type Enigma() = 
  interface IInteractiveServer with 
    member x.NewState: IInteractiveState = start() :> IInteractiveState 
    member x.ProcessResponse(state: IInteractiveState, response: obj): IInteractiveState = 
      let state = (state:?>InteractiveState<EnigmaTypes>) 
      state.ProcessResponse(response)

Start Your Engines!

Now the system is ready to rock! You will notice when the server starts it calls start() to obtain its first state. All the states are now just instances of record types. start() looks like this

1
2
3
4
5
 
let start() = 
  { displayOptions = fun _ -> ["Begin!",box ()] 
     displayText = fun _ -> "Welcome to the type provider Enigma machine!" 
     processResponse = fun (e,_) -> mainMenu(e) :> _ 
     state = Core defaultEnigma }

this is as simple as it gets and not doing much interesting, you can see it returns one property “Begin!” along with a boxed unit type. I don’t care about the response type as there is only one property so I know it must be that being selected.

processResponse simply creates the next state using the function mainMenu( .. ) which it passes the current state, in this case the default version of the enigma machine.

mainMenu(..) is much more interesting and too long to show here, so I will show some extracts / condensed versions

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
type MainMenuResponses = 
 | Nothing 
 | SelectLeftRotor 
 | SelectMiddleRotor 
 | SelectRightRotor 
 | SelectReflector 
 | SetWheelPosition 
 | SetRingPosition 
 | CreatePlugMapping 
 | Translate

let rec mainMenu(enigma:EnigmaTypes) =
  { displayOptions = fun _ -> 
    ["# ",box Nothing; 
     "Select a new left rotor",box SelectLeftRotor 
     "Select a new middle rotor",box SelectMiddleRotor ... ] 
    displayText = fun _ -> printMachine enigma.Enigma 
    processResponse = fun (e,r) -> 
      match unbox<MainMenuResponses> r with 
      | Nothing -> mainMenu(e) 
      | SelectLeftRotor -> 
        enterText("",[for i in 1..8-> sprintf "Rotor %i" i, box (string i)], 
          (fun s -> "Choose the rotor to place on the left"), 
          (fun s -> 
            let e = { e.Enigma with Left = getRotor s , WheelPosition 'A' } 
            mainMenu(Core e) :> IInteractiveState), 
          (fun _ -> false) )

The first bits are pretty straight forward, it shows the various menu options and boxes which one was selected using the DU defined above. processResponse then unboxes the return value, matches on it, then does something with the result.

In this case, it is calling another function called enterText – and this is where it gets really cool! enterText is defined as follows

1
2
3
4
5
6
7
8
 
let rec enterText(state:string,options,genDisplayText,continuation,repeatCondition) = 
  { displayOptions = fun _ -> options 
    displayText = fun d -> genDisplayText d 
    processResponse = fun (current:EnigmaTypes,c) -> 
      let s = current.String + string c 
      if repeatCondition s then enterText(s,options,genDisplayText,continuation,repeatCondition) :> _ 
      else continuation s 
    state = Strings state }

This function is designed based on the observation that when I want to accept an arbitrary amount of text from the user, the following is required

  1. A list of what inputs to be shown
  2. A way of knowing when to stop accepting more inputs (and recursively creating more types)
  3. A continuation function, that accepts the completed output and then generates some other state.

What is really awesome with is is that the enterText function simply takes a string – it doesn’t know or care about the Enigma object – this is made possible by the fact that we can now create a closure over the previous state’s data within the continuation lambda function, allowing us to decouple the recursive-text-entering portion of the type system. Very nice!

Engage Turbo Mode!

Great! now I can create re-usable state chunks and control stuff via closures. However, there is one more usually contrived problem that this system solves very well. Let’s take the menu function Adjust Wheel Position. This one is a little bit of a pain because it requires several steps – first you must pick which wheel you want to manipulate, then you choose the letter you wish to set it to. Usually you would have to model these as separate states, which would be confusing if you wanted to do the same thing somewhere else - but now you can actually compose these functions and closures together so that the whole intent and flow is clear within the same definition. For example :

1
2
3
4
5
6
7
8
9
 
let selectMachineRotor(continutation) = 
  { displayOptions = fun _ -> 
     ["Left Wheel", box LeftRotor 
      "Middle Wheel", box MiddleRotor 
      "Right Wheel", box RightRotor] 
    displayText = fun d -> "Select a rotor." 
    processResponse = fun (current,c) -> 
    continutation (c:?>MachineRotor) 
    state = Rotors MachineRotor.LeftRotor }

This function accepts a continuation function and asks the user to select a wheel, and calls the continuation function with their choice

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
 
| SetRingPosition -> 
  let apply l = function 
    | LeftRotor -> { e.Enigma with Left = { fst e.Enigma.Left with RingSetting = l }, snd e.Enigma.Left } 
    | MiddleRotor -> { e.Enigma with Middle = { fst e.Enigma.Middle with RingSetting = l }, snd e.Enigma.Middle} 
    | RightRotor -> { e.Enigma with Right = { fst e.Enigma.Right with RingSetting = l }, snd e.Enigma.Right }

  selectMachineRotor(fun rotor ->   
    enterText("",[for i in 'A'..'Z' -> sprintf "%c" i, box (string i)], 
      (fun s -> "Choose a letter"), 
      (fun s -> 
        let e = apply (RingSetting s.[0]) rotor 
        mainMenu(Core e) :> IInteractiveState), 
      (fun _ -> false) ) :> IInteractiveState )

When the SetRingPosition menu item is selected, it returns the selectMachineRotor function, and the continuation function passed to uses the enterText function allowing the user to pick a letter, and finally the result is applied to the Enigma object and the whole thin is returned back to the main menu. Very cool!

Straight away this is useful as the AdjustWheelPosition menu item has to do a very similar thing

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
 
| SetWheelPosition -> 
  let apply l = function 
    | LeftRotor -> { e.Enigma with Left = (fst e.Enigma.Left, l) } 
    | MiddleRotor -> { e.Enigma with Middle = (fst e.Enigma.Middle, l) } 
    | RightRotor -> { e.Enigma with Right = (fst e.Enigma.Right, l) }

  selectMachineRotor(fun rotor -> 
    enterText("",[for i in 'A'..'Z' -> sprintf "%c" i, box (string i)], 
      (fun s -> "Choose a letter"), 
      (fun s -> 
        let e = apply (WheelPosition s.[0]) rotor 
        mainMenu(Core e) :> IInteractiveState ), 
      (fun _ -> false) ) :> IInteractiveState )

Conclusion

The IP has had a bit of a face-lift which makes it easier to write and read what is going on. Plus you can have an Enigma machine in a type provider. Who wouldn’t want that! The code is a little bit of a mess at the moment, but I should clean it up soon and move the new super-state into the common interfaces project.